Transactor/Transactor_13_1986_Transactor_Publishing.d64/brk key 64.pal

Commodore BASIC | 2023-02-26 | 9KB | 371 lines

100 ;restore wedge -- break-time cmds.
110 ;by frank e. digioia
120 ;11/19/85
130 ;
140 * = $c500
150 ;
160 chrout = $ffd2   ;print char in .a
170 getin  = $ffe4   ;check keyboard
180 cold   = $fce2  ;cold system reset
190 ;
200 lda #<msg       ;point to mesg
210 ldy #>msg
220 jsr $ab1e       ;print mesg
230 ;
240 brkint lda #<rwdg ;setup nmi wedge
250 sta $0318        ;nmi vector
260 lda #>rwdg
270 sta $0319
280 rts
290 msg .byte 'break key 64 installed'
300 .byte $00
310 ;
320 rwdg pha         ;save regs
330 txa
340 pha
350 tya
360 pha
370 ;
380 lda #<brk2     ;disable recursion
390 ldx #>brk2
400 sta $0318
410 stx $0319
420 ;
430 jsr stop        ;scan stop key
440 bne *+5         ;not pressed
450 jmp newrsr      ;run/stop-restore
460 cli             ;allow keyboard
470 ;
480 wrloop jsr waitlp ;check keyboard
490 cmp #$0d        ;"carriage return?
500 beq [142]
510 cmp #"/"        ;"command coming?
520 bne wrloop      ;no/keep waiting
530 jsr chkcmd      ;check command
540 jmp wrloop      ;wait for more
550 ;
560 return jsr brkint ;restore wedge
570 jmp $febc       ;restore regs/rti
580 ;
590 waitlp jsr getin ;check keyboard
600 beq waitlp      ;"key pressed?
610 rts
620 ;
630 chk[157] jsr [146]lp  ;[161] cmmd byte
640 cmp #"h"        ;"hardcopy?
650 beq hrdcpy
660 cmp #"p"        ;"printer?
670 beq jmptab
680 cmp #"c"        ;"colors?
690 beq jmptab+3
700 cmp #"*"        ;"reset?
710 beq jmptab[170]6
720 cmp #"s"        ;"restore screen?
730 beq jmptab+9
740 cmp #"d"        ;"defaults?
750 beq jmptab[170]12
760 rts             ;[203] [164] [146] loop
770 ;
780 jmptab [178] [172]         ;jump table
790 jmp prnter
800 jmp col[176]s
820 jmp rscrn
830 jmp [150]alt
840 ;
850 [162]rsr [178] [172]   ;[162] [144][171][140]
860 jsr $fd15   ;initialize vec[164]rs
870 jsr $fda3   ;init sid[173]vic regs
880 jsr $e518   ;reset screen
890 jsr set[150]  ;set [150]ault col[176]s
900 jsr brk[181]  ;initialize wedge
910 jmp ($a002) ;basic warm start
920 ;
930 ;hrdcpy [171][171] dumps the text screen
940 ;[164] the [153]er. use [164] [148]
950 ;lo[171]res graphics, [168]es, etc.
960 ;
970 [159]   [178] $ffc0   ;[159] a file
980 [160]  [178] $ffc3   ;[160] a file
990 [156]ch  [178] $ffcc   ;set s[192]dard i[173]o
1000 chkout [178] $ffc9  ;set output device
1010 setlfs [178] $ffba   ;set file parms
1020 setnam [178] $ffbd   ;set [165] parms
1030 ;
1040 hrdcpy [178] [172] ;dump screen [164] [153]er
1050 lda #$92    ;n[176]mal mode flag
1060 sta revflg  ;set reverse flag
1070 lda #$7b    ;file #123
1080 jsr l[159]   ;[159] [153]er file
1090 ldx #$00
1100 stx $fb     ;s[164]re screen adr
1110 lda #$04
1120 sta $fc     ;as a po[181]er
1130 ;
1140 rwloop [178] [172]   ;loop over rows
1150 ldy #$00    ;reset column count
1160 ;
1170 chloop [178] [172]   ;loop over columns
1180 lda ($fb),y ;[161] chr from screen
1190 jsr chkmde  ;"normal or reverse?
1200 jsr decode  ;screen code to ascii
1210 jsr chrout  ;print the char.
1220 jsr stop    ;scan stop key
1230 beq hend    ;yes/finish up
1240 iny
1250 cpy #$28    ;"40th column yet?
1260 bcc chloop
1270 ;
1280 eopl [178] [172]    ;[128] of physical line
1290 lda #$0d   ;carriage [142]
1300 jsr chrout ;output it
1310 lda revflg ;[161] last mode [197]ue
1320 jsr chrout ;set the mode
1330 lda $fb    ;update screen po[181]er
1340 clc
1350 adc #$28   ;[164] [130] row
1360 sta $fb
1370 bcc [172][170]4    ;"need to incr hi byte?
1380 inc $fc
1390 inx        ;incr row counter
1400 cpx #$19   ;"25th row yet?
1410 bcc rwloop
1420 ;
1430 h[128] [178] [172]    ;finished!
1440 jsr [156]ch  ;[140] n[176]mal i[173]o
1450 lda #$7b
1460 jmp l[160] ;[160] [153]er
1470 ;
1480 revflg .byte $92
1490 ;
1500 ;decode [171][171] this routine c[145]verts
1510 ;a character from its screen
1520 ;code representati[145] [164] [198]ii.
1530 ;this is copied directly from
1540 ;the kernal rom at $e63e (curs[176]
1550 ;stuff [143]oved).
1560 ;
1570 decode [178] [172]  ;screen code [164] [198]ii
1580 sta $d7    ;s[164]re code
1590 [175] #$3f   ;mask out [164]p 2 bits
1600 asl $d7    ;mult code by two
1610 bit $d7    ;c[145]diti[145] flags
1620 bpl [172][170]4    ;"bit 7 clear?
1630 ora #$80   ;no - set bit 7 in .a
1640 bvs *+4    ;"bit 6 set?
1650 [176]a #$40   ;no [171] set bit 6
1660 rts        ;[198]ii code now in .a
1670 ;
1680 ;chkmde [171][171] checks [145] n[176]mal [176]
1690 ;reverse & s[128]s code [164] [153]er
1700 ;
1710 chkmde pha  ;[148] screen code
1720 lda revflg ;"what mode current?
1730 bmi nermal ;normal mode/skip
1740 pla        ;retrieve screen code
1750 bmi chkx   ;reverse/no sweat
1760 pha        ;save code again
1770 lda #$92   ;normal/kill reverse
1780 hc1 sta revflg ;toggle flag
1790 jsr chrout ;print the code
1800 pla        ;restore screen code
1810 chkx rts
1820 ;
1830 nermal pla  ;get screen code
1840 bpl chkx   ;normal/no sweat
1850 pha        ;save code again
1860 lda #$12   ;rev/switch mode
1870 bne hc1     ;finish up
1880 ;
1890 ;/c command (colors)
1900 ;
1910 colors lda #$03 ;code for 'c'
1920 jsr output  ;print command name
1930 zloop jsr waitlp  ;wait for key
1940 cmp #$0d    ;"return?
1950 bne [172][170]3     ;no[173]keep [203]ing
1960 rts
1970 ;
1980 cmp #"t"    ;"text?
1990 bne *+11    ;no/check on edge
2000 inc $0286   ;inc text color
2010 jsr chgtxt  ;change text color
2020 jmp zloop
2030 ;
2040 cmp #"e"    ;"edge (border)?
2050 bne [172][170]8     ;no[173]check [145] ground
2060 inc $d020   ;inc b[176]der col[176]
2070 jmp zloop
2080 ;
2090 cmp #"g"    ;"(back)ground?
2100 bne zloop   ;no/must be typo
2110 inc $d021   ;inc bckgrnd color
2120 jmp zloop
2130 ;
2140 ;/d command (set defaults)
2150 ;
2160 defalt = *
2170 lda #$04   ;code for 'd'
2180 jsr output ;print it
2190 lda $0286  ;get text color
2200 sta d1     ;save it
2210 lda $d020  ;get edge color
2220 sta d2     ;save it
2230 lda $d021  ;get ground color
2240 sta d3     ;save it
2250 rts        ;that's all folks
2260 ;
2270 d1 .byte $01
2280 d2 .byte $00
2290 d3 .byte $0a
2300 pflag .byte $7a
2310 ;
2320 ;output subroutine
2330 ;
2340 output = *       ;echo command
2350 sta $0427       ;corner of screen
2360 lda #$2f        ;slash code
2370 sta $0426       ;corner of screen
2380 lda #$20        ;space code
2390 sta $0425       ;corner of screen
2400 oxit rts         ;all done!
2410 ;
2420 ;/s command (output to screen)
2430 ;
2440 rscrn = *
2450 lda #$13       ;code for 's'
2460 jsr output     ;echo command
2470 lda pflag      ;"printer online?
2480 bpl oxit       ;no[173]d[145]'t bother
2490 lda #$7a       ;file #122
2500 sta pflag      ;set flag[173]offline
2510 jmp l[160]     ;[160] it up
2520 ;
2530 ;[173]p comm[175] (output [164] [153]er)
2540 ;
2550 prnter [178] [172]
2560 lda #$10      ;code [129] 'p'
2570 jsr output    ;echo comm[175]
2580 lda pflag     ;"printer online?
2590 bmi oxit      ;yes/don't bother
2600 lda #$ff      ;set printer online
2610 sta pflag     ;set flag
2620 lda #$7a      ;file #122
2630 jmp lopen
2640 ;
2650 ;text color subroutines
2660 ;
2670 colrst = $d800 ;start color mem
2680 colrnd = $dbe8 ;end color mem + 1
2690 ;
2700 chgtxt lda #<colrst ;set up adr
2710 sta $fb       ;pointer for start
2720 lda #>colrst  ;and end of color
2730 sta $fc       ;memory for fill.
2740 lda #<colrnd
2750 sta $fd
2760 lda #>colrnd
2770 sta $fe
2780 ;
2790 ldy #$00      ;.y is always zero
2800 ;
2810 cfloop lda $0286 ;get text color
2820 sta ($fb),y  ;fill color memory
2830 jsr incrmt   ;increment $fb/$fc
2840 jsr chek     ;compare start/end
2850 bcc cfloop   ;"end reached yet?
2860 ;
2870 incrmt clc    ;16 bit inc[143]ent
2880 lda #$01     ;inc[143]ent of 1
2890 adc $fb      ;inc[143]ent lo byte
2900 sta $fb      ;update it
2910 bcc [172][170]4      ;"increment hi byte?
2920 inc $fc
2930 rts
2940 ;
2950 chek lda $fc  ;compare 16 bit #'s
2960 cmp $fe      ;compare hi bytes
2970 bne *+6      ;'nuff said/return
2980 lda $fb      ;hi bytes equal so
2990 cmp $fd      ;low bytes get to
3000 rts          ;make the decision
3010 ;
3020 setdef lda d1 ;default text col
3030 sta $0286   ;set text color
3040 jsr chgtxt  ;fill color mem
3050 lda d2      ;default edge color
3060 sta $d020   ;set border color
3070 lda d3      ;default ground color
3080 sta $d021   ;set background col
3090 rts
3100 ;
3110 brk2 = *       ;user break 2
3120 pha           ;save regs
3130 txa
3140 pha
3150 tya
3160 pha
3170 ;
3180 jsr stop   ;scan stop key
3190 bne *+5    ;not pressed/continue
3200 jmp newrsr ;pressed/warm reset
3210 jmp $febc  ;restore regs & rti
3220 ;
3230 stop sta areg  ;save .a in memory
3240 stx xreg      ;save .x in memory
3250 jsr $f6bc     ;set stop flag
3260 jsr $ffe1     ;read stop flag
3270 php           ;save status word
3280 ldx xreg      ;get .x back
3290 lda areg      ;get .a back
3300 plp           ;get status word
3310 rts
3320 ;
3330 areg .byte $00
3340 xreg .byte $00
3350 ;
3360 ;lopen -- this routine opens a
3370 ;file to the printer (file no.
3380 ;is in .a on entry).  the
3390 ;printer is opened to whichever
3400 ;mode the screen is in.  i.e. if
3410 ;the screen is in the uppercase/
3420 ;lowercase mode, the printer
3430 ;will be also. the same applies to
3440 ;uppercase/graphics mode.
3450 ;
3460 lopen = *   ;open a printer file
3470 sta lfn
3480 lda $d018  ;which char setprint
3490 cmp #21    ;uppercase/graphics
3500 beq ug
3510 ldy #$07   ;sa for printer (u/l)
3520 .byte $2c  ;skip next instr
3530 ug ldy #$00 ;sa for upper/graphic
3540 lda lfn
3550 ldx #4     ;# for serial printer
3560 jsr setlfs
3570 lda #$00
3580 jsr setnam
3590 jsr open    ;system open routine
3600 ldx lfn     ;get file number
3610 jmp chkout  ;open output channel
3620 ;
3630 ;
3640 ;lclose - routine to close a
3650 ;file to the printer.  filenum
3660 ;in .a upon entry.
3670 ;
3680 lclose = *  ;close a printer file
3690 pha        ;save file number
3700 tax        ;get file number in .x
3710 jsr chkout ;open the channel
3720 lda #$0d   ;carriage return
3730 jsr chrout ;send to printer
3740 jsr clrch  ;reset standard i/o
3750 pla        ;get file number
3760 jmp close  ;close the file
3770 ;
3780 lfn .byte $0e
3790 ;
3800 .end